Cream of the Crop 26/Cream of the Crop 26.iso/program/p063b9s.zip/UNIT/NETFILE.PAS

Pascal/Delphi Source File | 1996-04-20 | 10KB | 368 lines

UNIT NetFile;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Share aware file routines                     Last changed: 20.04.96  SA ║}
{║                                                                          ║}
{║                         (C) Copyright 1989-94 by                         ║}
{║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
{║                                                                          ║}
{║ This source may not be given to anybody, without the written permission  ║}
{║ from The Portal Team.                                                    ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}

INTERFACE

USES Use32, Dos,
     PoPTypes;

CONST
  NoKeep = False;
  Keep   = True;
  NoWait = False;
  Wait   = True;

CONST  { To Grab/Release File }
  NetICFile = 0;
  NetNLFile = 1;

TYPE
  PNetFile = ^TNetFile;
  TNetFile = OBJECT
    f     : File;
    NetIo : Integer;
    FName : PathStr;

    CONSTRUCTOR OpenWithMode(CONST AFName: PathStr; ARecSize: Word; Create: Boolean; AMode: Word);
    CONSTRUCTOR Open(CONST AFName: PathStr; ARecSize: Word; Create: Boolean);
    DESTRUCTOR Close; VIRTUAL;
    FUNCTION  IoResult: Integer;
    FUNCTION  Lock(RecNum: LongInt; Wait: Boolean): Boolean;
    PROCEDURE UnLock(RecNum: LongInt);
    PROCEDURE GetRec(VAR Buffer; RecNum: LongInt; K,W: Boolean);
    PROCEDURE PutRec(VAR Buffer; RecNum: LongInt);
    PROCEDURE Read(VAR Buffer; K,W: Boolean);
    PROCEDURE Write(VAR Buffer);
    PROCEDURE BlockRead(VAR Buffer; Recs: Word);
    PROCEDURE BlockReadNum(VAR Buffer; Recs: Word; VAR ActRecs: Word);
    PROCEDURE ReadLine(VAR s: String);
    PROCEDURE ReadLineBack(VAR s: String);
    PROCEDURE BlockWrite(VAR Buffer; Recs: Word);
    PROCEDURE WriteLine(s: String);
    FUNCTION  FileSize: LongInt;
    FUNCTION  FilePos: LongInt;
    PROCEDURE Seek(RecNum: LongInt);
    FUNCTION  EoF: Boolean;
    PROCEDURE Truncate;
    FUNCTION  RecSize: Word;
    PROCEDURE CheckNetIo(CONST Where: S20);
  END;

FUNCTION  NetGrabFile(FileNum: Byte): Boolean;
PROCEDURE NetReleaseFile(FileNum: Byte);
PROCEDURE OpenLockFile;
PROCEDURE CloseLockFile;

IMPLEMENTATION

USES OpCrt, OpWindow, OpString, ApTimer,
     Share, LogFile, OProUtil, Util, Globals, StrUtil;

VAR
  LockFile : TNetFile;

  FUNCTION NetGrabFile(FileNum: Byte): Boolean;
  BEGIN
    NetGrabFile:=LockFile.Lock(FileNum, True);
  END;

  PROCEDURE NetReleaseFile(FileNum: Byte);
  BEGIN
    LockFile.UnLock(FileNum);
  END;

  PROCEDURE OpenLockFile;
  VAR
    i,j : Byte;
  BEGIN
    LockFile.Open(StartPath+PoPNetFileName, 1, True);
    j:=0;
    IF LockFile.FileSize<>32 THEN
      FOR i:=LockFile.FileSize TO 31 DO
        LockFile.PutRec(j,i);
  END;

  PROCEDURE CloseLockFile;
  BEGIN
    LockFile.Close;
  END;



  CONSTRUCTOR TNetFile.OpenWithMode(CONST AFName: PathStr; ARecSize: Word; Create: Boolean; AMode: Word);
  VAR
    Tries: Byte;
  BEGIN
    FName:=ReplaceEnv(AFName);
    NetIo:=0;
    IF InOutRes<>0 THEN AddLog('!','Untrapped I/O Error '+Long2Str(IOResult)+' before opening: '+FName);
    Assign(f, FName); FileMode:=AMode;
    Tries:=0;
    REPEAT
      Reset(f, ARecSize);
      NetIo:=System.IoResult;
      IF (NetIo=2) And (Create) THEN
      BEGIN
        ReWrite(f, ARecSize);
        NetIo:=System.IoResult;
        IF NetIo=5 THEN
          NetIo:=18
        ELSE
        BEGIN
          System.Close(f);
          NetIo:=255;   { Try opening it now.... }
        END;
      END;
      Inc(Tries);
    UNTIL (NetIo IN [0,3,4]) OR ((NetIo=2) And Not Create) Or (Tries>=5);
    IF (NetIO<>0) And (Tries>=5) And (Create) THEN
      AddLog('!','I/O Error '+Long2Str(NetIo)+' when creating: '+FName);
    IF NetIO=4 THEN AddLog('!', 'Too many open files - Increase FILES= in CONFIG.SYS');
    IF NetIo<>0 THEN Fail;
  END;

  CONSTRUCTOR TNetFile.Open(CONST AFName: PathStr; ARecSize: Word; Create: Boolean);
  BEGIN
    IF NOT TNetFile.OpenWithMode(AFName, ARecSize, Create, ShareRW+ShareDenyNone) THEN Fail;
  END;

  DESTRUCTOR TNetFile.Close;
  BEGIN
    CheckNetIo('Close');
    System.Close(f);
  END;

  FUNCTION TNetFile.IoResult: Integer;
  BEGIN
    IoResult:=NetIo;
    NetIo:=0;
  END;

  FUNCTION TNetFile.Lock(RecNum: LongInt; Wait: Boolean): Boolean;
  VAR
    t : EventTimer;
    i : Byte;
    LockErr : Word;
    WaitWin : WindowPtr;
    NL : Boolean;
  BEGIN
    CheckNetIo('Lock');
    NL:=Share.Lock(f, FileRec(f).RecSize*RecNum, FileRec(f).RecSize,LockErr);
    IF NOT NL AND Wait THEN
    BEGIN
      MyWin(WaitWin,1,ScreenHeight-2,80,ScreenHeight,3,' Record locked ',False);
      WaitWin^.wFastCenter(FName+', record '+Long2Str(RecNum),1,Cfg.Color[3].TextColor);
      NewTimerSecs(t, 60);
      REPEAT
        Pause(200+(Cfg.TaskNumber*20));
        NL:=Share.Lock(f, FileRec(f).RecSize*RecNum, FileRec(f).RecSize, LockErr);
      UNTIL NL OR TimerExpired(t) OR GotESC;
      IF NOT NL THEN AddLog(' ','Lock timeout on: '+FName+' ('+HexW(LockErr)+')');
      KillWindow(WaitWin);
    END;
    Lock:=NL;
  END;

  PROCEDURE TNetFile.UnLock(RecNum: LongInt);
  BEGIN
    CheckNetIo('UnLock');
    Share.UnLock(f,FileRec(f).RecSize*RecNum,FileRec(f).RecSize);
  END;

  PROCEDURE TNetFile.GetRec(VAR Buffer; RecNum: LongInt; K,W: Boolean);
  BEGIN
    CheckNetIo('GetRec');
    Seek(RecNum);
    NetIo:=System.IoResult;
    IF NetIo<>0 THEN Exit;
    IF NOT Lock(RecNum,W) THEN
    BEGIN
      NetIo:=107;
      Exit;
    END;
    System.BlockRead(f,Buffer,1);
    IF NOT K THEN UnLock(RecNum);
    NetIo:=System.IoResult;
  END;

  PROCEDURE TNetFile.PutRec(VAR Buffer; RecNum: LongInt);
  BEGIN
    CheckNetIo('PutRec');
    Seek(RecNum);
    NetIo:=System.IoResult;
    IF NetIo=0 THEN
    BEGIN
      System.BlockWrite(f,Buffer,1);
      UnLock(RecNum);
      NetIo:=System.IoResult;
    END;
  END;

  PROCEDURE TNetFile.Read(VAR Buffer; K,W: Boolean);
  BEGIN
    CheckNetIo('Read');
    IF EoF THEN
    BEGIN
      NetIo:=100;
    END ELSE
      IF NOT Lock(FilePos, W) THEN
      BEGIN
        IF W THEN Seek(FilePos+1);
        InOutRes:=0;
        NetIo:=107;
      END ELSE
      BEGIN
        System.BlockRead(f, Buffer, 1);
        IF NOT K THEN UnLock(FilePos-1);
        NetIo:=System.IoResult;
      END;
  END;

  PROCEDURE TNetFile.Write(VAR Buffer);
  BEGIN
    CheckNetIo('Write');
    System.BlockWrite(f, Buffer, 1);
    UnLock(FilePos-1);
    NetIo:=System.IoResult;
  END;

  PROCEDURE TNetFile.BlockRead(VAR Buffer; Recs: Word);
  BEGIN
    CheckNetIo('BlockRead');
    System.BlockRead(f, Buffer, Recs);
    NetIo:=System.IoResult;
  END;

  PROCEDURE TNetFile.BlockReadNum(VAR Buffer; Recs: Word; VAR ActRecs: Word);
  BEGIN
    CheckNetIo('BlockReadNum');
    System.BlockRead(f, Buffer, Recs, ActRecs);
    NetIo:=System.IoResult;
  END;

  PROCEDURE TNetFile.ReadLine(VAR s: String);
  VAR
    OldPos : LongInt;
    Buf    : Array[0..254] Of Char;
    Test   : Word;
    i      : Byte;
  BEGIN
    CheckNetIo('ReadLine');
    S:='';
    OldPos:=System.FilePos(f);
    System.BlockRead(f, Buf, SizeOf(Buf), Test);
    i:=0;
    WHILE (Test<>0) And (i<Test) AND (Buf[i]<>#10) DO
    BEGIN
      IF (Buf[i]<>#10) AND (Buf[i]<>#13) THEN S:=S+Buf[i];
      Inc(i);
    END;
    Seek(OldPos+i+1);
    IF System.IoResult<>0 THEN ;
  END;

  PROCEDURE TNetFile.ReadLineBack(VAR s: String);
  VAR
    x, OldPos : LongInt;
    Buf       : Array[1..255] Of Char;
    Test      : Integer;
    i         : Byte;
  BEGIN
    CheckNetIo('ReadLineBack');
    S:='';
    OldPos:=System.FilePos(f);
    If OldPos>SizeOf(buf) Then
    BEGIN
      System.Seek(f, OldPos-SizeOf(Buf)-3);
      i:=SizeOf(buf);
    END ELSE
    BEGIN
      System.Seek(f, 0);
      i:=OldPos;
    END;
    System.BlockRead(f, Buf, i, Test);
    WHILE (Test<>0) And (i>0) AND (Buf[i]<>#10) DO
    BEGIN
      IF (Buf[i]<>#10) AND (Buf[i]<>#13) THEN S:=Buf[i]+S;
      Dec(i);
    END;
    x:=OldPos-Test+i-1;
    IF x<0 THEN x:=0;
    System.Seek(f, x);
    IF System.IoResult<>0 THEN ;
  END;

  PROCEDURE TNetFile.BlockWrite(VAR Buffer; Recs: Word);
  BEGIN
    CheckNetIo('BlockWrite');
    System.BlockWrite(f, Buffer, Recs);
    NetIo:=System.IoResult;
  END;

  PROCEDURE TNetFile.WriteLine(s: String);
  BEGIN
    CheckNetIo('WriteLine');
    s:=s+#13#10;
    System.BlockWrite(f, s[1], Length(s));
    NetIo:=System.IoResult;
  END;

  FUNCTION TNetFile.FileSize: LongInt;
  BEGIN
    CheckNetIo('FileSize');
    FileSize:=System.FileSize(f);
    NetIo:=System.IoResult;
  END;

  FUNCTION TNetFile.EoF: Boolean;
  BEGIN
    CheckNetIo('EoF');
    EoF:=System.EoF(f);
    NetIo:=System.IoResult;
  END;

  FUNCTION TNetFile.FilePos: LongInt;
  BEGIN
    CheckNetIo('FilePos');
    FilePos:=System.FilePos(f);
    NetIo:=System.IoResult;
  END;

  PROCEDURE TNetFile.Seek(RecNum: LongInt);
  BEGIN
    CheckNetIo('Seek');
    System.Seek(f, RecNum);
    NetIo:=System.IoResult;
  END;

  PROCEDURE TNetFile.Truncate;
  BEGIN
    CheckNetIo('Truncate');
    System.Truncate(f);
    NetIo:=System.IoResult;
  END;

  FUNCTION TNetFile.RecSize: Word;
  BEGIN
    CheckNetIo('RecSize');
    RecSize:=FileRec(f).RecSize;
  END;

  PROCEDURE TNetFile.CheckNetIo(CONST Where: S20);
  BEGIN
    IF NetIo<>0 THEN AddLog('!','Untrapped I/O Error '+Long2Str(NetIO)+' in TNetFile.'+Where+' of file: '+FName);
{   NetIo:=0;}
  END;

END.